home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0487.arc / TELLO.ARC / IO.LSP < prev    next >
Encoding:
Text File  |  1986-12-22  |  1.8 KB  |  68 lines
  1. ; FPRINT
  2. ; Benchmark to print to a file.
  3.  
  4. (defvar test-atoms '(abcdef12 cdefgh23 efghij34 ghijkl45 ijklmn56 klmnop67
  5.                   mnopqr78 opqrst89 qrstuv90 stuvwx01 uvwxyz12
  6.                   wxyzab23 xyzabc34 123456ab 234567bc 345678cd
  7.                   456789de 567890ef 678901fg 789012gh 890123hi))
  8.  
  9. (defun fprint-init (m n atoms)
  10.        (let ((atoms (copy-tree atoms)))
  11.         (do ((a atoms (cdr a)))
  12.         ((null (cdr a)) (rplacd a atoms)))
  13.         (fprint-init1 m n atoms)))
  14.  
  15. (defun fprint-init1 (m n atoms)
  16.        (cond ((= m 0) (pop atoms))
  17.          (t (do ((i n (- i 2))
  18.              (a ()))
  19.             ((< i 1) a)
  20.             (push (pop atoms) a)
  21.             (push (fprint-init1 (1- m) n atoms) a)))))
  22.  
  23. (defvar test-pattern (fprint-init 6. 6. test-atoms))
  24.  
  25. (defparameter fprint-test-file "FPRINT.TST")
  26.  
  27. (defun fprint ()
  28.   (let ((f (open fprint-test-file :direction :output)))
  29.     (print test-pattern f)
  30.     (close f)))
  31.  
  32. (define-timer fprint "FPrint" (fprint))
  33.  
  34. ; FREAD
  35. ; Benchmark to read from a file.
  36.  
  37. (defun fread ()
  38.   (let ((f (open fprint-test-file)))
  39.     (read f)
  40.     (close f)))
  41.  
  42. (define-timer fread "FRead" (fread))
  43.  
  44. ; TPRINT
  45. ; Benchmark to print and read to the terminal
  46.  
  47. (defvar test-atoms '(abc1 cde2 efg3 ghi4 ijk5 klm6 mno7 opq8 qrs9
  48.             stu0 uvw1 wxy2 xyz3 123a 234b 345c 456d
  49.             567d 678e 789f 890g))
  50.  
  51. (defun tprint-init (m n atoms)
  52.        (let ((atoms (copy-tree atoms)))
  53.         (do ((a atoms (cdr a)))
  54.         ((null (cdr a)) (rplacd a atoms)))
  55.         (tprint-init1 m n atoms)))
  56.  
  57. (defun tprint-init1 (m n atoms)
  58.        (cond ((= m 0) (pop atoms))
  59.          (t (do ((i n (- i 2))
  60.              (a ()))
  61.             ((< i 1) a)
  62.             (push (pop atoms) a)
  63.             (push (tprint-init1 (1- m) n atoms) a)))))
  64.  
  65. (defvar test-pattern (tprint-init 6. 6. test-atoms))
  66.  
  67. (define-timer tprint "TPrint" (print test-pattern))
  68.